home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / nlcsrc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  20.8 KB  |  642 lines
  1. /* nlcsrc.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  33.         sfactr;
  34.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  35.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  36. } status_;
  37.  
  38. #define status_1 status_
  39.  
  40. struct {
  41.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  42.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  43. } flags_;
  44.  
  45. #define flags_1 flags_
  46.  
  47. struct {
  48.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  49.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  50.          pivrel;
  51. } knstnt_;
  52.  
  53. #define knstnt_1 knstnt_
  54.  
  55. struct {
  56.     doublereal value[200000];
  57. } blank_;
  58.  
  59. #define blank_1 blank_
  60.  
  61. /* Table of constant values */
  62.  
  63. static integer c__2 = 2;
  64. static integer c__0 = 0;
  65. static integer c__1 = 1;
  66.  
  67. /*<       subroutine nlcsrc >*/
  68. /* Subroutine */ int nlcsrc_()
  69. {
  70.     /* System generated locals */
  71.     integer i_1;
  72.     doublereal d_1, d_2, d_3;
  73.  
  74.     /* Local variables */
  75.     static doublereal cold;
  76.     static integer larg, ndim;
  77.     static doublereal csrc;
  78.     static integer lnod, lmat, lexp, loct, locy, iptr;
  79.     static doublereal volt;
  80.     static integer node1, node2, i;
  81.     static doublereal cgain;
  82.     static integer lcoef, ncoef;
  83.     static doublereal vgain;
  84.     static integer icheck;
  85. #define nodplc ((integer *)&blank_1)
  86. #define cvalue ((complex *)&blank_1)
  87.     extern /* Subroutine */ int sizmem_(), update_(), evpoly_();
  88.     static doublereal transr;
  89.     static integer lic;
  90.     static doublereal ceq;
  91.     static integer loc;
  92.     static doublereal geq, veq, tol;
  93.     static integer lvs;
  94.  
  95. /*<       implicit double precision (a-h,o-z) >*/
  96.  
  97. /*     this routine loads the nonlinear controlled sources into the */
  98. /* coefficient matrix. */
  99.  
  100. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  101. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  102. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  103. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  104. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  105. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  106. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  107. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  108. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  109. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  110. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  111. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  112. /* spice version 2g.6  sccsid=status 3/15/83 */
  113. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  114. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  115. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  116. /* spice version 2g.6  sccsid=flags 3/15/83 */
  117. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  118. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  119. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  120. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  121. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  122. /*<      2   pivtol,pivrel >*/
  123. /* spice version 2g.6  sccsid=blank 3/15/83 */
  124. /*<       common /blank/ value(200000) >*/
  125. /*<       integer nodplc(64) >*/
  126. /*<       complex cvalue(32) >*/
  127. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  128.  
  129. /*  nonlinear voltage-controlled current sources */
  130.  
  131. /*<       loc=locate(5) >*/
  132.     loc = cirdat_1.locate[4];
  133. /*<    10 if ((loc.eq.0).or.(nodplc(loc+13).ne.0)) go to 100 >*/
  134. L10:
  135.     if (loc == 0 || nodplc[loc + 12] != 0) {
  136.     goto L100;
  137.     }
  138. /*<       node1=nodplc(loc+2) >*/
  139.     node1 = nodplc[loc + 1];
  140. /*<       node2=nodplc(loc+3) >*/
  141.     node2 = nodplc[loc + 2];
  142. /*<       ndim=nodplc(loc+4) >*/
  143.     ndim = nodplc[loc + 3];
  144. /*<       lnod=nodplc(loc+6) >*/
  145.     lnod = nodplc[loc + 5];
  146. /*<       lmat=nodplc(loc+7) >*/
  147.     lmat = nodplc[loc + 6];
  148. /*<       lcoef=nodplc(loc+8) >*/
  149.     lcoef = nodplc[loc + 7];
  150. /*<       call sizmem(nodplc(loc+8),ncoef) >*/
  151.     sizmem_(&nodplc[loc + 7], &ncoef);
  152. /*<       larg=nodplc(loc+9) >*/
  153.     larg = nodplc[loc + 8];
  154. /*<       lexp=nodplc(loc+10) >*/
  155.     lexp = nodplc[loc + 9];
  156. /*<       lic=nodplc(loc+11) >*/
  157.     lic = nodplc[loc + 10];
  158. /*<       loct=nodplc(loc+12)+1 >*/
  159.     loct = nodplc[loc + 11] + 1;
  160. /*<       icheck=0 >*/
  161.     icheck = 0;
  162. /*<       do 20 i=1,ndim >*/
  163.     i_1 = ndim;
  164.     for (i = 1; i <= i_1; ++i) {
  165. /*<       call update(value(lic+i),loct,nodplc(lnod+1),nodplc(lnod+2),2, >*/
  166. /*<      1   icheck) >*/
  167.     update_(&blank_1.value[lic + i - 1], &loct, &nodplc[lnod], &nodplc[
  168.         lnod + 1], &c__2, &icheck);
  169. /*<       value(larg+i)=value(lx0+loct) >*/
  170.     blank_1.value[larg + i - 1] = blank_1.value[tabinf_1.lx0 + loct - 1];
  171. /*<       loct=loct+2 >*/
  172.     loct += 2;
  173. /*<       lnod=lnod+2 >*/
  174.     lnod += 2;
  175. /*<    20 continue >*/
  176. /* L20: */
  177.     }
  178. /*<       call evpoly(cold,0,lcoef,ncoef,larg,ndim,lexp) >*/
  179.     evpoly_(&cold, &c__0, &lcoef, &ncoef, &larg, &ndim, &lexp);
  180. /*<       loct=nodplc(loc+12) >*/
  181.     loct = nodplc[loc + 11];
  182. /*<       if (icheck.eq.1) go to 30 >*/
  183.     if (icheck == 1) {
  184.     goto L30;
  185.     }
  186. /*<       if (initf.eq.6) go to 30 >*/
  187.     if (status_1.initf == 6) {
  188.     goto L30;
  189.     }
  190. /*<       tol=reltol*dmax1(dabs(cold),dabs(value(lx0+loct)))+abstol >*/
  191. /* Computing MAX */
  192.     d_2 = abs(cold), d_3 = (d_1 = blank_1.value[tabinf_1.lx0 + loct - 1], abs(
  193.         d_1));
  194.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.abstol;
  195. /*<       if (dabs(cold-value(lx0+loct)).lt.tol) go to 40 >*/
  196.     if ((d_1 = cold - blank_1.value[tabinf_1.lx0 + loct - 1], abs(d_1)) < tol)
  197.          {
  198.     goto L40;
  199.     }
  200. /*<    30 noncon=noncon+1 >*/
  201. L30:
  202.     ++status_1.noncon;
  203. /*<    40 value(lx0+loct)=cold >*/
  204. L40:
  205.     blank_1.value[tabinf_1.lx0 + loct - 1] = cold;
  206. /*<       ceq=cold >*/
  207.     ceq = cold;
  208. /*<       do 50 i=1,ndim >*/
  209.     i_1 = ndim;
  210.     for (i = 1; i <= i_1; ++i) {
  211. /*<       call evpoly(geq,i,lcoef,ncoef,larg,ndim,lexp) >*/
  212.     evpoly_(&geq, &i, &lcoef, &ncoef, &larg, &ndim, &lexp);
  213. /*<       loct=loct+2 >*/
  214.     loct += 2;
  215. /*<       value(lx0+loct)=geq >*/
  216.     blank_1.value[tabinf_1.lx0 + loct - 1] = geq;
  217. /*<       ceq=ceq-geq*value(larg+i) >*/
  218.     ceq -= geq * blank_1.value[larg + i - 1];
  219. /*<       locy=lvn+nodplc(lmat+1) >*/
  220.     locy = tabinf_1.lvn + nodplc[lmat];
  221. /*<       value(locy)=value(locy)+geq >*/
  222.     blank_1.value[locy - 1] += geq;
  223. /*<       locy=lvn+nodplc(lmat+2) >*/
  224.     locy = tabinf_1.lvn + nodplc[lmat + 1];
  225. /*<       value(locy)=value(locy)-geq >*/
  226.     blank_1.value[locy - 1] -= geq;
  227. /*<       locy=lvn+nodplc(lmat+3) >*/
  228.     locy = tabinf_1.lvn + nodplc[lmat + 2];
  229. /*<       value(locy)=value(locy)-geq >*/
  230.     blank_1.value[locy - 1] -= geq;
  231. /*<       locy=lvn+nodplc(lmat+4) >*/
  232.     locy = tabinf_1.lvn + nodplc[lmat + 3];
  233. /*<       value(locy)=value(locy)+geq >*/
  234.     blank_1.value[locy - 1] += geq;
  235. /*<       lmat=lmat+4 >*/
  236.     lmat += 4;
  237. /*<    50 continue >*/
  238. /* L50: */
  239.     }
  240. /*<       value(lvn+node1)=value(lvn+node1)-ceq >*/
  241.     blank_1.value[tabinf_1.lvn + node1 - 1] -= ceq;
  242. /*<       value(lvn+node2)=value(lvn+node2)+ceq >*/
  243.     blank_1.value[tabinf_1.lvn + node2 - 1] += ceq;
  244. /*<       loc=nodplc(loc) >*/
  245.     loc = nodplc[loc - 1];
  246. /*<       go to 10 >*/
  247.     goto L10;
  248.  
  249. /*  nonlinear voltage controlled voltage sources */
  250.  
  251. /*<   100 loc=locate(6) >*/
  252. L100:
  253.     loc = cirdat_1.locate[5];
  254. /*<   110 if ((loc.eq.0).or.(nodplc(loc+14).ne.0)) go to 200 >*/
  255. L110:
  256.     if (loc == 0 || nodplc[loc + 13] != 0) {
  257.     goto L200;
  258.     }
  259. /*<       node1=nodplc(loc+2) >*/
  260.     node1 = nodplc[loc + 1];
  261. /*<       node2=nodplc(loc+3) >*/
  262.     node2 = nodplc[loc + 2];
  263. /*<       ndim=nodplc(loc+4) >*/
  264.     ndim = nodplc[loc + 3];
  265. /*<       iptr=nodplc(loc+6) >*/
  266.     iptr = nodplc[loc + 5];
  267. /*<       lnod=nodplc(loc+7) >*/
  268.     lnod = nodplc[loc + 6];
  269. /*<       lmat=nodplc(loc+8) >*/
  270.     lmat = nodplc[loc + 7];
  271. /*<       lcoef=nodplc(loc+9) >*/
  272.     lcoef = nodplc[loc + 8];
  273. /*<       call sizmem(nodplc(loc+9),ncoef) >*/
  274.     sizmem_(&nodplc[loc + 8], &ncoef);
  275. /*<       larg=nodplc(loc+10) >*/
  276.     larg = nodplc[loc + 9];
  277. /*<       lexp=nodplc(loc+11) >*/
  278.     lexp = nodplc[loc + 10];
  279. /*<       lic=nodplc(loc+12) >*/
  280.     lic = nodplc[loc + 11];
  281. /*<       loct=nodplc(loc+13)+2 >*/
  282.     loct = nodplc[loc + 12] + 2;
  283. /*<       icheck=0 >*/
  284.     icheck = 0;
  285. /*<       do 120 i=1,ndim >*/
  286.     i_1 = ndim;
  287.     for (i = 1; i <= i_1; ++i) {
  288. /*<       call update(value(lic+i),loct,nodplc(lnod+1),nodplc(lnod+2),2, >*/
  289. /*<      1   icheck) >*/
  290.     update_(&blank_1.value[lic + i - 1], &loct, &nodplc[lnod], &nodplc[
  291.         lnod + 1], &c__2, &icheck);
  292. /*<       value(larg+i)=value(lx0+loct) >*/
  293.     blank_1.value[larg + i - 1] = blank_1.value[tabinf_1.lx0 + loct - 1];
  294. /*<       loct=loct+2 >*/
  295.     loct += 2;
  296. /*<       lnod=lnod+2 >*/
  297.     lnod += 2;
  298. /*<   120 continue >*/
  299. /* L120: */
  300.     }
  301. /*<       call evpoly(volt,0,lcoef,ncoef,larg,ndim,lexp) >*/
  302.     evpoly_(&volt, &c__0, &lcoef, &ncoef, &larg, &ndim, &lexp);
  303. /*<       loct=nodplc(loc+13) >*/
  304.     loct = nodplc[loc + 12];
  305. /*<       if (icheck.eq.1) go to 130 >*/
  306.     if (icheck == 1) {
  307.     goto L130;
  308.     }
  309. /*<       if (initf.eq.6) go to 130 >*/
  310.     if (status_1.initf == 6) {
  311.     goto L130;
  312.     }
  313. /*<       tol=reltol*dmax1(dabs(volt),dabs(value(lx0+loct)))+vntol >*/
  314. /* Computing MAX */
  315.     d_2 = abs(volt), d_3 = (d_1 = blank_1.value[tabinf_1.lx0 + loct - 1], abs(
  316.         d_1));
  317.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.vntol;
  318. /*<       if (dabs(volt-value(lx0+loct)).lt.tol) go to 140 >*/
  319.     if ((d_1 = volt - blank_1.value[tabinf_1.lx0 + loct - 1], abs(d_1)) < tol)
  320.          {
  321.     goto L140;
  322.     }
  323. /*<   130 noncon=noncon+1 >*/
  324. L130:
  325.     ++status_1.noncon;
  326. /*<   140 value(lx0+loct)=volt >*/
  327. L140:
  328.     blank_1.value[tabinf_1.lx0 + loct - 1] = volt;
  329. /*<       value(lx0+loct+1)=value(lvnim1+iptr) >*/
  330.     blank_1.value[tabinf_1.lx0 + loct] = blank_1.value[tabinf_1.lvnim1 + iptr 
  331.         - 1];
  332. /*<       veq=volt >*/
  333.     veq = volt;
  334. /*<       locy=lvn+nodplc(lmat+1) >*/
  335.     locy = tabinf_1.lvn + nodplc[lmat];
  336. /*<       value(locy)=+1.0d0 >*/
  337.     blank_1.value[locy - 1] = 1.;
  338. /*<       locy=lvn+nodplc(lmat+2) >*/
  339.     locy = tabinf_1.lvn + nodplc[lmat + 1];
  340. /*<       value(locy)=-1.0d0 >*/
  341.     blank_1.value[locy - 1] = -1.;
  342. /*<       locy=lvn+nodplc(lmat+3) >*/
  343.     locy = tabinf_1.lvn + nodplc[lmat + 2];
  344. /*<       value(locy)=+1.0d0 >*/
  345.     blank_1.value[locy - 1] = 1.;
  346. /*<       locy=lvn+nodplc(lmat+4) >*/
  347.     locy = tabinf_1.lvn + nodplc[lmat + 3];
  348. /*<       value(locy)=-1.0d0 >*/
  349.     blank_1.value[locy - 1] = -1.;
  350. /*<       lmat=lmat+4 >*/
  351.     lmat += 4;
  352. /*<       loct=loct+1 >*/
  353.     ++loct;
  354. /*<       do 150 i=1,ndim >*/
  355.     i_1 = ndim;
  356.     for (i = 1; i <= i_1; ++i) {
  357. /*<       call evpoly(vgain,i,lcoef,ncoef,larg,ndim,lexp) >*/
  358.     evpoly_(&vgain, &i, &lcoef, &ncoef, &larg, &ndim, &lexp);
  359. /*<       loct=loct+2 >*/
  360.     loct += 2;
  361. /*<       value(lx0+loct)=vgain >*/
  362.     blank_1.value[tabinf_1.lx0 + loct - 1] = vgain;
  363. /*<       veq=veq-vgain*value(larg+i) >*/
  364.     veq -= vgain * blank_1.value[larg + i - 1];
  365. /*<       locy=lvn+nodplc(lmat+1) >*/
  366.     locy = tabinf_1.lvn + nodplc[lmat];
  367. /*<       value(locy)=value(locy)-vgain >*/
  368.     blank_1.value[locy - 1] -= vgain;
  369. /*<       locy=lvn+nodplc(lmat+2) >*/
  370.     locy = tabinf_1.lvn + nodplc[lmat + 1];
  371. /*<       value(locy)=value(locy)+vgain >*/
  372.     blank_1.value[locy - 1] += vgain;
  373. /*<       lmat=lmat+2 >*/
  374.     lmat += 2;
  375. /*<   150 continue >*/
  376. /* L150: */
  377.     }
  378. /*<       value(lvn+iptr)=veq >*/
  379.     blank_1.value[tabinf_1.lvn + iptr - 1] = veq;
  380. /*<       loc=nodplc(loc) >*/
  381.     loc = nodplc[loc - 1];
  382. /*<       go to 110 >*/
  383.     goto L110;
  384.  
  385. /*  nonlinear current-controlled current sources */
  386.  
  387. /*<   200 loc=locate(7) >*/
  388. L200:
  389.     loc = cirdat_1.locate[6];
  390. /*<   210 if ((loc.eq.0).or.(nodplc(loc+13).ne.0)) go to 300 >*/
  391. L210:
  392.     if (loc == 0 || nodplc[loc + 12] != 0) {
  393.     goto L300;
  394.     }
  395. /*<       node1=nodplc(loc+2) >*/
  396.     node1 = nodplc[loc + 1];
  397. /*<       node2=nodplc(loc+3) >*/
  398.     node2 = nodplc[loc + 2];
  399. /*<       ndim=nodplc(loc+4) >*/
  400.     ndim = nodplc[loc + 3];
  401. /*<       lvs=nodplc(loc+6) >*/
  402.     lvs = nodplc[loc + 5];
  403. /*<       lmat=nodplc(loc+7) >*/
  404.     lmat = nodplc[loc + 6];
  405. /*<       lcoef=nodplc(loc+8) >*/
  406.     lcoef = nodplc[loc + 7];
  407. /*<       call sizmem(nodplc(loc+8),ncoef) >*/
  408.     sizmem_(&nodplc[loc + 7], &ncoef);
  409. /*<       larg=nodplc(loc+9) >*/
  410.     larg = nodplc[loc + 8];
  411. /*<       lexp=nodplc(loc+10) >*/
  412.     lexp = nodplc[loc + 9];
  413. /*<       lic=nodplc(loc+11) >*/
  414.     lic = nodplc[loc + 10];
  415. /*<       loct=nodplc(loc+12)+1 >*/
  416.     loct = nodplc[loc + 11] + 1;
  417. /*<       icheck=0 >*/
  418.     icheck = 0;
  419. /*<       do 220 i=1,ndim >*/
  420.     i_1 = ndim;
  421.     for (i = 1; i <= i_1; ++i) {
  422. /*<       iptr=nodplc(lvs+i) >*/
  423.     iptr = nodplc[lvs + i - 1];
  424. /*<       iptr=nodplc(iptr+6) >*/
  425.     iptr = nodplc[iptr + 5];
  426. /*<       call update(value(lic+i),loct,iptr,1,2,icheck) >*/
  427.     update_(&blank_1.value[lic + i - 1], &loct, &iptr, &c__1, &c__2, &
  428.         icheck);
  429. /*<       value(larg+i)=value(lx0+loct) >*/
  430.     blank_1.value[larg + i - 1] = blank_1.value[tabinf_1.lx0 + loct - 1];
  431. /*<       loct=loct+2 >*/
  432.     loct += 2;
  433. /*<   220 continue >*/
  434. /* L220: */
  435.     }
  436. /*<       call evpoly(csrc,0,lcoef,ncoef,larg,ndim,lexp) >*/
  437.     evpoly_(&csrc, &c__0, &lcoef, &ncoef, &larg, &ndim, &lexp);
  438. /*<       loct=nodplc(loc+12) >*/
  439.     loct = nodplc[loc + 11];
  440. /*<       if (icheck.eq.1) go to 230 >*/
  441.     if (icheck == 1) {
  442.     goto L230;
  443.     }
  444. /*<       if (initf.eq.6) go to 230 >*/
  445.     if (status_1.initf == 6) {
  446.     goto L230;
  447.     }
  448. /*<       tol=reltol*dmax1(dabs(csrc),dabs(value(lx0+loct)))+abstol >*/
  449. /* Computing MAX */
  450.     d_2 = abs(csrc), d_3 = (d_1 = blank_1.value[tabinf_1.lx0 + loct - 1], abs(
  451.         d_1));
  452.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.abstol;
  453. /*<       if (dabs(csrc-value(lx0+loct)).lt.tol) go to 240 >*/
  454.     if ((d_1 = csrc - blank_1.value[tabinf_1.lx0 + loct - 1], abs(d_1)) < tol)
  455.          {
  456.     goto L240;
  457.     }
  458. /*<   230 noncon=noncon+1 >*/
  459. L230:
  460.     ++status_1.noncon;
  461. /*<   240 value(lx0+loct)=csrc >*/
  462. L240:
  463.     blank_1.value[tabinf_1.lx0 + loct - 1] = csrc;
  464. /*<       ceq=csrc >*/
  465.     ceq = csrc;
  466. /*<       do 250 i=1,ndim >*/
  467.     i_1 = ndim;
  468.     for (i = 1; i <= i_1; ++i) {
  469. /*<       call evpoly(cgain,i,lcoef,ncoef,larg,ndim,lexp) >*/
  470.     evpoly_(&cgain, &i, &lcoef, &ncoef, &larg, &ndim, &lexp);
  471. /*<       loct=loct+2 >*/
  472.     loct += 2;
  473. /*<       value(lx0+loct)=cgain >*/
  474.     blank_1.value[tabinf_1.lx0 + loct - 1] = cgain;
  475. /*<       ceq=ceq-cgain*value(larg+i) >*/
  476.     ceq -= cgain * blank_1.value[larg + i - 1];
  477. /*<       locy=lvn+nodplc(lmat+1) >*/
  478.     locy = tabinf_1.lvn + nodplc[lmat];
  479. /*<       value(locy)=value(locy)+cgain >*/
  480.     blank_1.value[locy - 1] += cgain;
  481. /*<       locy=lvn+nodplc(lmat+2) >*/
  482.     locy = tabinf_1.lvn + nodplc[lmat + 1];
  483. /*<       value(locy)=value(locy)-cgain >*/
  484.     blank_1.value[locy - 1] -= cgain;
  485. /*<       lmat=lmat+2 >*/
  486.     lmat += 2;
  487. /*<   250 continue >*/
  488. /* L250: */
  489.     }
  490. /*<       value(lvn+node1)=value(lvn+node1)-ceq >*/
  491.     blank_1.value[tabinf_1.lvn + node1 - 1] -= ceq;
  492. /*<       value(lvn+node2)=value(lvn+node2)+ceq >*/
  493.     blank_1.value[tabinf_1.lvn + node2 - 1] += ceq;
  494. /*<       loc=nodplc(loc) >*/
  495.     loc = nodplc[loc - 1];
  496. /*<       go to 210 >*/
  497.     goto L210;
  498.  
  499. /*  nonlinear current controlled voltage sources */
  500.  
  501. /*<   300 loc=locate(8) >*/
  502. L300:
  503.     loc = cirdat_1.locate[7];
  504. /*<   310 if ((loc.eq.0).or.(nodplc(loc+14).ne.0)) go to 1000 >*/
  505. L310:
  506.     if (loc == 0 || nodplc[loc + 13] != 0) {
  507.     goto L1000;
  508.     }
  509. /*<       node1=nodplc(loc+2) >*/
  510.     node1 = nodplc[loc + 1];
  511. /*<       node2=nodplc(loc+3) >*/
  512.     node2 = nodplc[loc + 2];
  513. /*<       ndim=nodplc(loc+4) >*/
  514.     ndim = nodplc[loc + 3];
  515. /*<       ibr=nodplc(loc+6) >*/
  516.     cirdat_1.ibr = nodplc[loc + 5];
  517. /*<       lvs=nodplc(loc+7) >*/
  518.     lvs = nodplc[loc + 6];
  519. /*<       lmat=nodplc(loc+8) >*/
  520.     lmat = nodplc[loc + 7];
  521. /*<       lcoef=nodplc(loc+9) >*/
  522.     lcoef = nodplc[loc + 8];
  523. /*<       call sizmem(nodplc(loc+9),ncoef) >*/
  524.     sizmem_(&nodplc[loc + 8], &ncoef);
  525. /*<       larg=nodplc(loc+10) >*/
  526.     larg = nodplc[loc + 9];
  527. /*<       lexp=nodplc(loc+11) >*/
  528.     lexp = nodplc[loc + 10];
  529. /*<       lic=nodplc(loc+12) >*/
  530.     lic = nodplc[loc + 11];
  531. /*<       loct=nodplc(loc+13)+2 >*/
  532.     loct = nodplc[loc + 12] + 2;
  533. /*<       icheck=0 >*/
  534.     icheck = 0;
  535. /*<       do 320 i=1,ndim >*/
  536.     i_1 = ndim;
  537.     for (i = 1; i <= i_1; ++i) {
  538. /*<       iptr=nodplc(lvs+i) >*/
  539.     iptr = nodplc[lvs + i - 1];
  540. /*<       iptr=nodplc(iptr+6) >*/
  541.     iptr = nodplc[iptr + 5];
  542. /*<       call update(value(lic+i),loct,iptr,1,2,icheck) >*/
  543.     update_(&blank_1.value[lic + i - 1], &loct, &iptr, &c__1, &c__2, &
  544.         icheck);
  545. /*<       value(larg+i)=value(lx0+loct) >*/
  546.     blank_1.value[larg + i - 1] = blank_1.value[tabinf_1.lx0 + loct - 1];
  547. /*<       loct=loct+2 >*/
  548.     loct += 2;
  549. /*<   320 continue >*/
  550. /* L320: */
  551.     }
  552. /*<       call evpoly(volt,0,lcoef,ncoef,larg,ndim,lexp) >*/
  553.     evpoly_(&volt, &c__0, &lcoef, &ncoef, &larg, &ndim, &lexp);
  554. /*<       loct=nodplc(loc+13) >*/
  555.     loct = nodplc[loc + 12];
  556. /*<       if (icheck.eq.1) go to 330 >*/
  557.     if (icheck == 1) {
  558.     goto L330;
  559.     }
  560. /*<       if (initf.eq.6) go to 330 >*/
  561.     if (status_1.initf == 6) {
  562.     goto L330;
  563.     }
  564. /*<       tol=reltol*dmax1(dabs(volt),dabs(value(lx0+loct)))+vntol >*/
  565. /* Computing MAX */
  566.     d_2 = abs(volt), d_3 = (d_1 = blank_1.value[tabinf_1.lx0 + loct - 1], abs(
  567.         d_1));
  568.     tol = knstnt_1.reltol * max(d_3,d_2) + knstnt_1.vntol;
  569. /*<       if (dabs(volt-value(lx0+loct)).lt.tol) go to 340 >*/
  570.     if ((d_1 = volt - blank_1.value[tabinf_1.lx0 + loct - 1], abs(d_1)) < tol)
  571.          {
  572.     goto L340;
  573.     }
  574. /*<   330 noncon=noncon+1 >*/
  575. L330:
  576.     ++status_1.noncon;
  577. /*<   340 value(lx0+loct)=volt >*/
  578. L340:
  579.     blank_1.value[tabinf_1.lx0 + loct - 1] = volt;
  580. /*<       value(lx0+loct+1)=value(lvnim1+ibr) >*/
  581.     blank_1.value[tabinf_1.lx0 + loct] = blank_1.value[tabinf_1.lvnim1 + 
  582.         cirdat_1.ibr - 1];
  583. /*<       veq=volt >*/
  584.     veq = volt;
  585. /*<       locy=lvn+nodplc(lmat+1) >*/
  586.     locy = tabinf_1.lvn + nodplc[lmat];
  587. /*<       value(locy)=+1.0d0 >*/
  588.     blank_1.value[locy - 1] = 1.;
  589. /*<       locy=lvn+nodplc(lmat+2) >*/
  590.     locy = tabinf_1.lvn + nodplc[lmat + 1];
  591. /*<       value(locy)=-1.0d0 >*/
  592.     blank_1.value[locy - 1] = -1.;
  593. /*<       locy=lvn+nodplc(lmat+3) >*/
  594.     locy = tabinf_1.lvn + nodplc[lmat + 2];
  595. /*<       value(locy)=+1.0d0 >*/
  596.     blank_1.value[locy - 1] = 1.;
  597. /*<       locy=lvn+nodplc(lmat+4) >*/
  598.     locy = tabinf_1.lvn + nodplc[lmat + 3];
  599. /*<       value(locy)=-1.0d0 >*/
  600.     blank_1.value[locy - 1] = -1.;
  601. /*<       lmat=lmat+4 >*/
  602.     lmat += 4;
  603. /*<       loct=loct+1 >*/
  604.     ++loct;
  605. /*<       do 350 i=1,ndim >*/
  606.     i_1 = ndim;
  607.     for (i = 1; i <= i_1; ++i) {
  608. /*<       call evpoly(transr,i,lcoef,ncoef,larg,ndim,lexp) >*/
  609.     evpoly_(&transr, &i, &lcoef, &ncoef, &larg, &ndim, &lexp);
  610. /*<       loct=loct+2 >*/
  611.     loct += 2;
  612. /*<       value(lx0+loct)=transr >*/
  613.     blank_1.value[tabinf_1.lx0 + loct - 1] = transr;
  614. /*<       veq=veq-transr*value(larg+i) >*/
  615.     veq -= transr * blank_1.value[larg + i - 1];
  616. /*<       locy=lvn+nodplc(lmat+i) >*/
  617.     locy = tabinf_1.lvn + nodplc[lmat + i - 1];
  618. /*<       value(locy)=value(locy)-transr >*/
  619.     blank_1.value[locy - 1] -= transr;
  620. /*<   350 continue >*/
  621. /* L350: */
  622.     }
  623. /*<       value(lvn+ibr)=veq >*/
  624.     blank_1.value[tabinf_1.lvn + cirdat_1.ibr - 1] = veq;
  625. /*<       loc=nodplc(loc) >*/
  626.     loc = nodplc[loc - 1];
  627. /*<       go to 310 >*/
  628.     goto L310;
  629.  
  630. /*  finished */
  631.  
  632. /*<  1000 return >*/
  633. L1000:
  634.     return 0;
  635. /*<       end >*/
  636. } /* nlcsrc_ */
  637.  
  638. #undef cvalue
  639. #undef nodplc
  640.  
  641.  
  642.